home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The PC-SIG Library 10
/
The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso
/
PC_SIGCD
/
03
/
1
/
DISK0317.ZIP
/
SCHEDU.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-05-31
|
19KB
|
297 lines
99 '=====================FIRST LINE OF THE PROGRAM======================
100 DRIVE$="b:" 'sets default data dr..
120 '=====================MAIN SCREEN ==================================
130 KEY OFF 'turns off 25th line
140 IF CHECK=1 THEN SCREEN ,,1 :GOTO 405 'when check,show scrn 1
150 SCREEN ,,1 'sets input to screen s
160 CLS 'clear screen 1
170 LOCATE 9,1 'go to line 9, column 1
180 PRINT" SELECT:
190 LOCATE ,20:PRINT"1-See a certain date Schedule
200 LOCATE ,20:PRINT"2-Add in the Schedule
210 LOCATE ,20:PRINT"3-Initilize disk
220 LOCATE ,20:PRINT"4-Change defalult drive
230 LOCATE ,20:PRINT"5-Clear part of data
240 LOCATE ,20:PRINT"6-Add constant occuring activity
250 LOCATE ,20:PRINT"7-Print Activity on printer
260 LOCATE ,20:PRINT"8 or Esc-End Program
265 LOCATE 20,20:PRINT "Drive:" 'displays default drv.
270 LOCATE 9,20:FOR Z=1 TO 37:PRINT CHR$(205);:NEXT 'graphs upper line
280 PRINT CHR$(187) 'graphs corner
290 FOR Z=10 TO 18:LOCATE Z,57:PRINT CHR$(186):NEXT 'graphs right horzline
300 LOCATE 18,57:PRINT CHR$(188) 'graphs corner
310 FOR Z=56 TO 20 STEP -1:LOCATE 18,Z:PRINT CHR$(205):NEXT 'bottom line
320 LOCATE 18,19:PRINT CHR$(200) 'graphs corner
330 FOR Z=17 TO 10 STEP -1:LOCATE Z,19:PRINT CHR$(186):NEXT 'left line
340 LOCATE 9,19:PRINT CHR$(201) 'graphs corner
350 LOCATE 3,1:FOR Z=1 TO 80:PRINT CHR$(223);:NEXT 'uper line
360 FOR Z=3 TO 21:LOCATE Z,80:PRINT CHR$(219):NEXT 'right line
370 FOR Z=79 TO 1 STEP -1:LOCATE 21,Z:PRINT CHR$(220):NEXT 'down line
380 FOR Z=21 TO 3 STEP -1 :LOCATE Z,1:PRINT CHR$(219):NEXT 'left line
390 CHECK=1
400 '================= cheking which key was pressed ===========================
405 LOCATE 20,26:IF DRIVE$=""THEN PRINT "current" ELSE PRINT LEFT$(DRIVE$,1)+" "
407 LOCATE 20,32:PRINT" Date:" DATE$ " " TIME$ " "
410 K$=INKEY$:IF K$="" THEN 407 'waiting for input
420 IF K$="1" THEN SCREEN ,,0,0: GOTO 1590 'see day appointments
430 IF K$="2" THEN SCREEN ,,0,0:CLS:GOTO 1740 'write day appointment
440 IF K$="3" THEN SCREEN ,,0,0:CLS:GOTO 1900 'initialize disk
450 IF K$="4" THEN SCREEN ,,0,0:CLS:GOTO 2000 'change default drive
460 IF K$="5" THEN SCREEN ,,0,0:CLS:GOTO 2100 'clear part of data
470 IF K$="6" THEN SCREEN ,,0,0: GOTO 2200 'add const. occ. actv.
480 IF K$="7" THEN SCREEN ,,0,0: GOTO 2300 'Print time activity
490 IF K$="8" OR K$=CHR$(27) THEN SCREEN 0,0,0:CLS:KEY 9,"key on":KEY ON:LOCATE 12,20: PRINT"PROGRAM ENDED":END
500 IF (K$="h") OR (K$="H") THEN SCREEN ,,0:SCREEN ,,,0:PRINT"N. AVAILABLE":END
505 IF RIGHT$(K$,1)="I" THEN SCREEN ,,,0:GOTO 410
506 IF RIGHT$(K$,1)="Q" THEN 140
510 DEF SEG=0: POKE 1050, PEEK (1052) 'clear buffer
520 BEEP: LOCATE 22,1:PRINT SPC(24) "Choose from 1 to 8 !!!
530 FOR A=1 TO 1000:NEXT 'delay loop
540 DEF SEG=0: POKE 1050, PEEK (1052) 'clear buffer
550 LOCATE 22,9:PRINT " "'erase
560 GOTO 410 'goto Mn Scrn
570 '
580 '================== inputing month =========================================
590 '
600 CLS
610 LOCATE 25,1:COLOR 0,7:PRINT" E a s y E d i t M o d e Esc = Main Screen ";: COLOR 7,0
615 DEF SEG = &H40: POKE &H17, PEEK(&H17) AND 171 'turn off Caps Lock
620 LOCATE 2,2:PRINT"Choose a Month? ";
630 COLOR 16+7 : PRINT "_" : COLOR 7 '========== prnt cursor
640 K$=INKEY$:IF K$="" OR K$=CHR$(8) OR K$=CHR$(13) THEN 640
650 IF K$=CHR$(27) THEN 120 '========================== Esc=Mn Scrn
660 LOCATE 2,18:PRINT K$;
670 IF K$="f" OR K$="F" THEN MNT$="february":LOCATE 2,18: PRINT MNT$:GOTO 910
680 IF K$="s" OR K$="S" THEN MNT$="september":LOCATE 2,18: PRINT MNT$:GOTO 910
690 IF K$="o" OR K$="O" THEN MNT$="october" :LOCATE 2,18: PRINT MNT$:GOTO 910
700 IF K$="n" OR K$="N" THEN MNT$="november":LOCATE 2,18: PRINT MNT$:GOTO 910
710 IF K$="d" OR K$="D" THEN MNT$="december":LOCATE 2,18: PRINT MNT$:GOTO 910
720 COLOR 16+7 : PRINT "_" : COLOR 7 '================== prnt cursor
730 LOCATE 25,1:COLOR 0,7:PRINT"Cursor keys disabled. Esc= start again";: COLOR 7,0
740 K2$=INKEY$:IF LEN(K2$)<>1 OR K2$=CHR$(8) THEN 740
750 IF K2$=CHR$(27) THEN 600
760 LOCATE 2,19:PRINT K2$;
770 COLOR 16+7 : LOCATE 2,20:PRINT "_" : COLOR 7
780 IF (K$="a" OR K$="A") AND (K2$="u" OR K2$="U") THEN MNT$="august" : LOCATE 2,18: PRINT MNT$:GOTO 910
790 IF (K$="a" OR K$="A") AND (K2$="p" OR K2$="P") THEN MNT$="april" : LOCATE 2,18: PRINT MNT$:GOTO 910
800 IF (K$="j" OR K$="J") AND (K2$="a" OR K2$="A") THEN MNT$="january" :LOCATE 2,18: PRINT MNT$:GOTO 910
810 K3$=INKEY$:IF LEN(K3$)<>1 OR K3$=CHR$(8) THEN 810
820 IF K3$=CHR$(27) THEN 600
830 LOCATE 2,20:PRINT K3$;
840 COLOR 16+7 : PRINT "_" : COLOR 7
850 IF (K$="j" OR K$="J") AND (K2$="u" OR K2$="U") AND (K3$="n" OR K3$="N") THEN MNT$="june":LOCATE 2,18:PRINT MNT$:GOTO 910
860 IF (K$="j" OR K$="J") AND (K2$="u" OR K2$="U") AND (K3$="l" OR K3$="L") THEN MNT$="july":LOCATE 2,18:PRINT MNT$:GOTO 910
870 IF (K$="m" OR K$="M") AND (K2$="a" OR K2$="A") AND (K3$="r" OR K3$="R") THEN MNT$="march":LOCATE 2,18:PRINT MNT$:GOTO 910
880 IF (K$="m" OR K$="M") AND (K2$="a" OR K2$="A") AND (K3$="y" OR K3$="y") THEN MNT$="may":LOCATE 2,18:PRINT MNT$+" ":GOTO 910
890 BEEP:CLS:LOCATE 25,1:COLOR 0,7:PRINT"Invalid month name....Begin again" SPC(45);:COLOR 7,0
891 GOTO 620
892 '=========== subroutine to determine name of day ==================
893 DEF FNZEL(M,D,Y)=(D+M+M+INT((M+1)*.6)+Y+Y\4-Y\100+Y\400+1) MOD 7
894 DEF FNDAY$(D)=MID$("SunMonTueWedThuFriSat",D*3+1,3)
895 DEF FNMON$(M)=MID$("JanFebMarAprMayJunJulAugSepOctNovDec",(M-1)*3+1,3)
896 MONTH=MONTH: DAY=DAY: YEAR=1984 '=================================
897 IF YEAR<100 THEN YEAR=YEAR+1900 ' Assume 20th century if not specified
898 IF YEAR<1582 THEN 901 ELSE IF YEAR>1582 THEN 902
899 IF MONTH<10 THEN 901 ELSE IF MONTH>10 THEN 902
900 IF DAY>14 THEN 902
901 PRINT "Not valid before Oct 15, 1582"
902 IF MONTH<1 OR MONTH>12 THEN PRINT "Month Invalid" :STOP
903 IF MONTH > 2 THEN 906
904 DAY.OF.WEEK=FNZEL(MONTH+12,DAY,YEAR-1) ' Jan & Feb
905 GOTO 907
906 DAY.OF.WEEK=FNZEL(MONTH,DAY,YEAR) ' Mar-Dec
907 DAY$=STR$(DAY)
908 WEEKDAY$=FNDAY$(DAY.OF.WEEK)
909 RETURN
910 '========= assigning end, begin value according to month ===================
920 IF MNT$="january" THEN BEGIN=1 :EN=31 :MONTH=1:GOTO 1050
930 IF MNT$="february" THEN BEGIN=32 :EN=59 :MONTH=2:GOTO 1050
940 IF MNT$="march" THEN BEGIN=60 :EN=90 :MONTH=3:GOTO 1050
950 IF MNT$="april" THEN BEGIN=91 :EN=120:MONTH=4:GOTO 1050
960 IF MNT$="may" THEN BEGIN=121 :EN=151:MONTH=5:GOTO 1050
970 IF MNT$="june" THEN BEGIN=152 :EN=181:MONTH=6:GOTO 1050
980 IF MNT$="july" THEN BEGIN=182 :EN=212:MONTH=7:GOTO 1050
990 IF MNT$="august" THEN BEGIN=213 :EN=243:MONTH=8:GOTO 1050
1000 IF MNT$="september" THEN BEGIN=244 :EN=273:MONTH=9:GOTO 1050
1010 IF MNT$="october" THEN BEGIN=274 :EN=304:MONTH=10:GOTO 1050
1020 IF MNT$="november" THEN BEGIN=305 :EN=334:MONTH=11:GOTO 1050
1030 IF MNT$="december" THEN BEGIN=335 :EN=365:MONTH=12:GOTO 1050
1040 PRINT"invalid month!":GOTO 600
1050 '
1060 '========= finding the particular day ======================================
1065 PLAY"L35A+G-"
1070 LOCATE 25,1:COLOR 0,7:PRINT"Cursor keys enabled. enter day=o to start again";: COLOR 7,0
1080 LOCATE 3,1
1090 DEF SEG=0: POKE 1050, PEEK (1052)
1100 FOR DELAY=1 TO 99: NEXT
1110 INPUT" Which day";DAY
1120 IF DAY=0 THEN 600
1125 IF DAY>32 THEN 1110
1127 GOSUB 892
1130 RETURN
1140 '============== writing information to disk ================================
1150 LOCATE 2,1
1160 EMP$=""
1170 OPEN DRIVE$+"scd" AS #1 LEN=25
1175 DEF SEG =&H40: POKE &H17, PEEK (&H17) OR 64
1180 FIELD #1, 25 AS F$
1190 R=2: C=1:J=0: SWITCH=0
1200 FOR A=1 TO 5:EMP$=EMP$ + CHR$( SCREEN(R,C+A+J)):NEXT
1210 COLOR 15 : LOCATE R,C+1+J: PRINT EMP$
1220 K$=INKEY$: IF K$="" THEN :COLOR 7:LOCATE 22,10:PRINT TIME$:GOTO 1220
1230 IF K$=CHR$(13) THEN 1290
1235 IF K$="r" OR K$="R" THEN CLOSE:GOTO 1610 'go to reading mode
1240 IF LEN(K$)<>2 AND K$<>CHR$(13) THEN BEEP: GOTO 1220
1250 R$=RIGHT$(K$,1)
1255 IF R$="H" THEN R2=R:R=R-1:IF J=39 AND R=1 THEN J=0:R=17:SWITCH=39:GOTO 1280 ELSE IF J=0 AND R=1 THEN R=2:GOTO 1220 ELSE GOTO 1280
1260 IF R$="P" THEN R2=R:R=R+1:IF R=18 AND J=0 THEN J=39:R=2:SWITCH=-39:GOTO 1280 ELSE IF R=18 AND J=39 THEN R=17:GOTO 1220 ELSE GOTO 1280
1270 IF R$="O" THEN 1350 ELSE GOTO 1220
1280 LOCATE R2,C+1+J+SWITCH: COLOR 7: PRINT EMP$: EMP$="":SWITCH=0:GOTO 1200
1290 LOCATE R,C+7+J: COLOR 7:LINE INPUT DAT$
1295 IF DAT$="" THEN DAT$=CHR$(32)
1300 LSET F$=DAT$
1310 IF J=0 THEN ADD=0 ELSE IF J=39 THEN ADD=16 ELSE PRINT"error":STOP
1320 PUT # 1,INT(32*(BEGIN+DAY-2)+ADD+ R-1)
1340 R=R+1: R2=R-1:IF R=18 THEN R=17
1345 GOTO 1280
1350 CLOSE: COLOR 7
1360 RETURN
1370 '=============== readong info from disk ====================================
1380 OPEN DRIVE$+"scd" AS #1 LEN=25
1390 FIELD #1, 25 AS E$
1410 COLOR 0,7:LOCATE 1:PRINT" TIME ACTIVITY TIME ACTIVITY ":COLOR 7,0
1420 COUNT=5.5
1430 Y$="00": Z$="30":CON=1
1440 FOR I=1 TO 16
1450 COUNT=COUNT+.5: IF COUNT>9.5 THEN CON=0
1460 IF COUNT>12.5 THEN CON=1
1470 GET # 1,INT(32*(BEGIN+DAY-2)+I)
1480 SWAP Z$,Y$
1490 IF COUNT>12.99 THEN COUNT =1
1500 LOCATE I+1,1+CON:PRINT STR$( INT(COUNT) );":";Z$;: LOCATE I+1,8:PRINT E$;
1510 NEXT
1520 CON=0
1530 FOR I=1 TO 16
1540 GET # 1,INT(32*(BEGIN+DAY-2)+I+16):COUNT=COUNT+.5: SWAP Z$, Y$: IF COUNT>9.600001 THEN CON=-1
1550 LOCATE I+1,40+CON :PRINT STR$( INT(COUNT) );":";Z$;: LOCATE I+1,47:PRINT E$;
1560 NEXT
1570 CLOSE
1580 RETURN
1590 '====================== seeing a certain date schedules ====================
1600 GOSUB 580: CLS 'get month and day
1610 GOSUB 1370 'go to seeing module
1620 LOCATE 18,1:COLOR 0,7: 'reverse vidio setting
1630 LOCATE 18,1:COLOR 0,7:PRINT" Reading Mode. Strike a Key to Continue ":COLOR 7,0
1640 LOCATE 19:PRINT CHR$(221);" DATE: KEYS:" SPC(18):LOCATE 19,79:PRINT CHR$(222)
1650 LOCATE 20:PRINT CHR$(221);" Day:";WEEKDAY$;" "DAY;:LOCATE ,50:PRINT " Pg Up:Perv day":LOCATE 20,79:PRINT CHR$(222)
1660 LOCATE 21:PRINT CHR$(221);" Month:";MNT$;:LOCATE ,52:PRINT"Pg Dn:next day" :LOCATE 21,79:PRINT CHR$(222)
1670 PRINT CHR$(221);" TIME: W:Go to Writing Mode ": LOCATE 22,79:PRINT CHR$(222)
1680 COLOR 0,7:PRINT " ": COLOR 7,0
1685 LOCATE 19,58:COLOR 23:PRINT "_":COLOR 7 'display blinking cursr
1690 K$=INKEY$:IF K$="" THEN LOCATE 22,10: PRINT TIME$:GOTO 1690
1700 K$=RIGHT$(K$,1) '=the rightmost charctr
1705 IF K$="W" OR K$="w" THEN 1762 'go to Write subroutine
1710 IF K$="I" THEN IF DAY>1 THEN LET DAY=DAY-1:GOSUB 893:GOTO 1610 ELSE IF DAY=1 THEN 1690
1720 IF K$="Q" THEN IF DAY<32 THEN DAY=DAY+1:GOSUB 893:GOTO 1610 ELSE GOTO 1690
1730 GOTO 120 'go to main screen
1740 '================ writing schedule =============
1750 GOSUB 580: CLS 'get month and day
1760 GOSUB 1370 'display info
1762 LOCATE 18,1:COLOR 0,7:PRINT " Writing Mode ":COLOR 7,0
1763 LOCATE 19:PRINT CHR$(221);" DATE: KEYS: R:Go to Reading Mode":LOCATE 19,79:PRINT CHR$(222)
1764 LOCATE 20 :PRINT CHR$(221);" Day:";WEEKDAY$DAY;:LOCATE ,50:PRINT "<ENTER>:Write ":LOCATE 20,79:PRINT CHR$(222)
1765 LOCATE 21:PRINT CHR$(221);" Month:";MNT$;:LOCATE ,52:PRINT CHR$(24) " & " CHR$(25) ":Move Cursor": LOCATE 21,79:PRINT CHR$(222)
1766 PRINT CHR$(221) " TIME:"; :LOCATE ,54:PRINT "End:Save & go to Mn Scrn":LOCATE 22,79:PRINT CHR$(222)
1767 COLOR 0,7 :PRINT " ": COLOR 7,0
1770 GOSUB 1140 'go to write info 2dsk
1780 GOTO 120 'go to min acreen
1900 '================= initilizig the disk ===============================
1902 PRINT "Are You Sure?"
1903 K$=INKEY$: IF K$="y" OR K$="Y" THEN 1905 ELSE IF K$="" THEN 1903 ELSE GOTO 120
1905 PRINT"this is gonna take a couple of minutes. So.."'print message-
1906 PRINT "Relax, tell you hear the beep." ,SPC(80) 'at the top
1910 OPEN DRIVE$+"scd" AS #1 LEN=25 'open scd data file
1920 FIELD #1, 25 AS F$ 'sets field buffer
1925 FOR AA%=1 TO 11680 'loops the whole-
1930 DAT$=CHR$(32) 'data file, and -
1940 LSET F$=DAT$ 'inserts chr$(32)-
1950 PUT # 1,AA% 'to every record -
1955 NEXT 'in the file
1970 CLOSE 'closes file
1980 BEEP: PRINT" disk initilized" 'beeps
1985 FOR A=1 TO 1509: NEXT 'delay loop
1999 GOTO 120 'goto main screen
2000 '================ changing default drive ===========================
2010 LOCATE ,,1:PRINT"Select drive ?"; 'print message @top
2020 K$=INKEY$:IF K$ ="" THEN 2020 'looks for input
2030 PRINT 'print empty line
2045 LOCATE ,,0 'turn off cursor
2060 DRIVE$=K$+":" 'sets value of dr..
2070 GOTO 120 'go to main screen
2100 '================== erasing part of data ==================================
2110 CLS
2120 PRINT"Data to be cleared beginning:" 'print message @ top
2130 GOSUB 610 'get begin and day
2132 START= 32*(BEGIN+DAY-2) 'calculate start
2135 CLS 'clear screen
2140 PRINT"Data to be cleared until & including:" 'prnt message @ top
2150 GOSUB 610 'begin&day for finsh
2155 FINISH=32*(BEGIN+DAY-2)+32 'calcualte finish
2160 PRINT"Erasing........" 'print message
2170 OPEN DRIVE$+"scd" AS #1 LEN=25 'open file to erase-
2180 FIELD #1, 25 AS F$ 'the part assigned
2182 FOR A%=START+1 TO FINISH 'loop to add a blank
2183 IF A=0 THEN A=1 'ords
2190 DAT$=CHR$(32) 'ords
2192 LSET F$=DAT$ 'ords
2194 PUT # 1,A%
2195 NEXT
2196 BEEP:CLOSE: COLOR 7 'beep when finish
2197 GOTO 120 'goto main screen
2200 '================== adding constant occuring activity =====================
2210 CLS
2220 PRINT"Data to be entered beginning:" 'print message @ top
2230 GOSUB 610 'get begin and day
2232 START= 32*(BEGIN+DAY-2) 'calculate start
2235 CLS 'clear screen
2240 PRINT"Data to be entered until & including:" 'prnt message @ top
2250 GOSUB 610 'begin&day for finsh
2255 FINISH=32*(BEGIN+DAY-2)+32 'calcualte finish
2257 PRINT "TIME:":INPUT "Hour";HR:HR=INT(HR)
2258 INPUT "Minute (0 or 30)";MIN: IF MIN <>0 AND MIN<>30 THEN 2258
2260 LOCATE ,,1 :PRINT"AM or PM?";
2262 K$=INKEY$: IF K$="" THEN 2262
2264 IF K$<>"a" AND K$<>"A" AND K$<>"p" AND K$<>"P" THEN BEEP: GOTO 2262 ELSE LOCATE ,,0:PRINT K$
2265 IF K$="p" OR K$="P" THEN XX=HR*2+12
2266 IF K$="a" OR K$="A" THEN XX=HR*2-12
2267 INPUT "Activity?";ACT$
2268 IF MIN=30 THEN XX=XX+1
2270 OPEN DRIVE$+"scd" AS #1 LEN=25 'open file to erase-
2280 FIELD #1, 25 AS F$ 'the part assigned
2282 FOR A%=START+1+XX TO FINISH STEP 32 'loop to add a blank
2283 IF A=0 THEN A=1 'ords
2290 DAT$=ACT$
2292 LSET F$=DAT$ 'ords
2294 PUT # 1,A%
2295 NEXT
2296 BEEP:CLOSE: COLOR 7 'beep when finish
2297 GOTO 120 'goto main screen
2300 '================ printing module =========================================
2305 GOSUB 590 'month & day input
2310 CLS 'clear screen
2320 PRINT "Turn printer on then strike a key"
2330 IF INKEY$="" THEN 2330 'waiting for Keypressed
2340 CLS:GOSUB 1380 'display activites
2345 LOCATE 19,20:PRINT "Month:" MNT$ ". Day:" DAY
2346 PRINT
2347 LOCATE ,20:COLOR 0,7:PRINT " P R I N T I N G ! ! !":COLOR 7,0
2350 LPRINT CHR$(14);"TIME ACTIVITY TIME ACTIVITY":LPRINT CHR$(18)
2360 FOR LIN=2 TO 19
2370 FOR COLUMN=1 TO 78
2380 LPRINT CHR$(SCREEN(LIN,COLUMN));
2390 NEXT
2400 LPRINT CHR$(0)
2500 NEXT
2600 GOTO 140
2700 '===================LAST LINE=============================================